home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.05 May 88 / forth source / TEStylDemo.standalone < prev    next >
Encoding:
Text File  |  1988-03-06  |  17.1 KB  |  681 lines  |  [TEXT/MACH]
  1. \ New Text Edit example
  2. \ J. Langowski for Mac Tutor March 1988
  3. \ derived from
  4. \ Editor Shell Example Program on Mach 2 demo disk
  5.  
  6. \ found two 'features' of the new text edit while experimenting:
  7. \ a. when the insertion point is at a boundary between
  8. \    two different styles, the text typed will be TEKeyed 
  9. \    according to the style BEFORE the insertion point, while
  10. \    TEGetStyle will return style information from AFTER the
  11. \    insertion point.
  12. \ b. Although the text face seems to be set inside the style record
  13. \    and properly associated with the text (TEGetStyle returns the correct
  14. \    information after the text face has been changed), the text is
  15. \    always drawn plain text style. The font and size changes work OK.
  16. \
  17.  
  18. only forth definitions
  19. also assembler also mac
  20.  
  21. \ ***** constants
  22.  
  23. 300 CONSTANT APPLEID \ menu IDs for the menus to be set up
  24. 310 CONSTANT FILEID
  25. 320 CONSTANT EDITID
  26. 330 CONSTANT SIZEID
  27. 340 CONSTANT FontID
  28. 350 CONSTANT StyleID
  29.  
  30. 20  CONSTANT InUpArrow     \ part code for up arrow of scrollbar
  31. 21  CONSTANT InDownArrow \ part code for down arrow of scrollbar
  32. 22  CONSTANT InPageUp     \ part code for page up region of scrollbar
  33. 23  CONSTANT InPageDown     \ part code for page down region of scrollbar
  34. 129 CONSTANT InThumb     \ part code for thumb of scrollbar
  35.  
  36. $44525652 Constant "drvr
  37. $464F4E54 Constant "font
  38.  
  39. %000001000000000 CONSTANT ShiftMask \ Mask used to isolate shift bit
  40.                     \ in modifiers word of event record
  41.  
  42. $10 CONSTANT    portRect \ Grafport rectangle
  43. $6E CONSTANT    wVisible \ visible flag [byte]
  44.  
  45. \ text edit equates
  46. 0  CONSTANT    teDestRect    ( destination rectangle  [8 bytes] )
  47. 8  CONSTANT    teViewRect    ( view rectangle rectangle [8 bytes] )
  48. $C  CONSTANT    selRect        ( select rectangle [8 bytes] )
  49. $18 CONSTANT    teLineHite    ( line height [word] )
  50. $1A CONSTANT    teFontAscent    \ font ascent [word]
  51. $1C CONSTANT    teSelPoint    \ selection point [long word]
  52. $20 CONSTANT    teSelStart    ( selection start [word] )
  53. $22 CONSTANT    teSelEnd    ( selection end [word] )
  54. $38 CONSTANT    teCarOn        ( is caret on? [byte] )
  55. $39 CONSTANT    teCarAct    ( is caret active? [byte] )
  56. $3C CONSTANT    teLength    ( length of text below [word] )
  57. $3E CONSTANT    teTextH        ( text [handle] )
  58. $48 CONSTANT    teCROnly    ( <CR> only for line breaks? [byte] )
  59. $4A CONSTANT    teFont        ( text font [word] )
  60. $4C CONSTANT    teFace        ( text face [word] )
  61. $4A CONSTANT    teStylHandle    \ handle to style record for new
  62.                 \ text edit. Never accessed directly
  63. $4E CONSTANT    teMode        \ text mode [word] 
  64. $50 CONSTANT    teSize    \ font size [word] for old style record.
  65.             \ for a new style record, this contains -1.
  66.             \ in that case, teFont and teFace together contain
  67.             \ the handle to the style record.
  68. $5E CONSTANT    teNLines    ( number of lines [word] )
  69. $60 CONSTANT    teLines        ( lines starts [word] )
  70.                 
  71.                 ( TextEdit Globals )
  72. $AB0 CONSTANT    TEScrpLength    ( textEdit Scrap Length [word] )
  73. $AB4 CONSTANT    TEScrpHandle    ( textEdit Scrap [handle] )
  74. $AF6 CONSTANT    TEWdBreak    ( default word break routine [pointer] )
  75.  
  76. \ Event Record Equates
  77. $0 CONSTANT    What        ( event code [word] )
  78. $2 CONSTANT    Message        ( event message [long] )    
  79. $6 CONSTANT    When        ( ticks since start-up  [long] )
  80. $A CONSTANT    Where        ( mouse loc. pt. in global coords [long] )
  81. $E CONSTANT    Modifiers    ( modifier flags  [word] )
  82.  
  83. $0A CONSTANT LF        ( ascii 'linefeed' )
  84. $20 CONSTANT SP        ( ascii 'space' )
  85.  
  86. create applestring 01 C, $14 C, \ Apple symbol
  87.  
  88. \ ***** variables
  89.  
  90. VARIABLE TEHandle        ( handle for text edit record )
  91. VARIABLE TERect     4 VALLOT    ( Text Edit view rectangle )
  92. VARIABLE SIZE            ( item# of current textsize )
  93. VARIABLE DESKNAME 252 VALLOT    \ holds name of desk accessory
  94. VARIABLE FONTNAME 252 VALLOT    \ holds font name selected
  95. VARIABLE ITEMNAME 60 VALLOT    \ receives menu item name
  96. VARIABLE MyStyle 8 VALLOT    \ text style record for our private use
  97.     \ fields of MyStyle:
  98.         0 CONSTANT tsFont
  99.         2 CONSTANT tsFace
  100.         4 CONSTANT tsSize
  101.         6 CONSTANT RGBColor
  102. VARIABLE currentFont    \ font menu ID currently checked
  103. VARIABLE #fonts        \ # of currently installed fonts
  104. VARIABLE currentSize    \ size menu ID currently checked
  105.  
  106. 76  USER AbortHook
  107. 152 USER ContentHook
  108. 160 USER GrowHook
  109. 164 USER CloseBoxHook
  110. 168 USER UpdateHook
  111. 172 USER ActivateHook
  112. 202 USER CAction    \ holds address of control action routine
  113.  
  114. \ ***** glue routines for new text edit
  115. \
  116. \ TEStylNew ( destRect viewRect -- TEHandle )
  117. \ is misspelled 'TEStyleNew' in the Mach2 trap definitions,
  118. \ but implemented. So are TEGetOffset and most of the other 
  119. \ new text edit routines that are called through TEDispatch.
  120. \ One exception is TEStylInsert, which we are defining here:
  121.  
  122. CODE TEStylInsert ( text length hST hTE -- )
  123.     EXG D4,A7
  124.     MOVE.L    $C(A6),-(A7)    \ pointer to text
  125.     MOVE.L    $8(A6),-(A7)    \ length of text
  126.     MOVE.L    $4(A6),-(A7)    \ style record handle
  127.     MOVE.L    (A6),-(A7)    \ TE record handle
  128.     ADDA.W    #$10,A6
  129.     MOVE.W    #$7,-(A7)
  130.     _TEDispatch
  131.     EXG    D4,A7
  132.     RTS
  133. END-CODE
  134.  
  135.  
  136. NEW.WINDOW Editor
  137. " Editor" Editor TITLE
  138. 42 4 330 507 Editor BOUNDS
  139. DOCUMENT INVISIBLE CLOSEBOX GROWBOX Editor ITEMS
  140.  
  141. 200 1000 TERMINAL EditTask
  142.  
  143. NEW.MBAR EditBar 
  144.  
  145. NEW.MENU AppleMenu
  146. APPLESTRING AppleMenu TITLE
  147. 0 APPLEID AppleMenu BOUNDS
  148. " About Editor ...;(-" AppleMenu ITEMS
  149.  
  150. NEW.MENU FileMenu
  151. " File" FileMenu TITLE
  152. 0 FileID FileMenu BOUNDS
  153. " New/N;Open.../O;Close;Save;Save as...;Revert to Original;(Print"
  154.                             FileMenu ITEMS
  155.  
  156. NEW.MENU EditMenu
  157. " Edit" EditMenu TITLE
  158. 0 EDITID EditMenu BOUNDS
  159. " (Undo/Z;(-;Cut/K;Copy/C;Paste/V;Clear" EditMenu ITEMS
  160.  
  161. NEW.MENU FontMenu
  162. " Font" FontMenu TITLE
  163. 0 FontID FontMenu BOUNDS
  164. "  (Fonts<I; (-" FontMenu ITEMS
  165.  
  166. NEW.MENU SizeMenu
  167. " Size" SizeMenu TITLE
  168. 0 SizeID SizeMenu BOUNDS
  169. "  9 Point; 10 Point; 12 Point; 14 Point; 18 Point; 20 Point; 24 Point" 
  170.         SizeMenu ITEMS
  171.  
  172. CREATE SizeIDTable
  173. 0 , 0 , 0 c, \ no menu IDs for sizes 0 thru 8
  174. 1 c, 2 c, 0 c, 3 c, \  9,10,--,12
  175. 0 c, 4 c, 0 c, 0 c, \ --,14,--,--
  176. 0 c, 5 c, 0 c, 6 c, \ --,18,--,20
  177. 0 c, 0 c, 0 c, 7 c, \ --,--,--,24
  178.  
  179. CREATE SizeTable
  180. 0 c, 9 c, 10 c, 12 c, 14 c, 18 c, 20 c, 24 c,
  181.  
  182.  
  183. NEW.MENU StyleMenu
  184. " Style" StyleMenu TITLE
  185. 0 StyleID StyleMenu BOUNDS
  186. "  Plain/P; Bold/B<B; Italic/I<I; Underline/U<U; Outline<O; Shadow<S; Condense; Extend" 
  187.         StyleMenu ITEMS
  188.  
  189. NEW.CONTROL Scroll                
  190. VSCROLLBAR VISIBLE 100 0 Scroll ITEMS
  191. VARIABLE lastVs
  192.  
  193. NEW.CONTROL hScroll                
  194. HSCROLLBAR VISIBLE 100 0 hScroll ITEMS
  195. VARIABLE lastHs
  196.  
  197. : CHECK  ( menuhandle item# flag -- )    ( checking a menu item )
  198.     CALL CheckItem ;
  199.     
  200. : =string { aStr bStr | -- flag }
  201.     aStr count 65536 * bStr count rot + swap
  202.     call CmpString 0=
  203. ;
  204.  
  205. CODE @TEHandle    ( -- handle )        ( an assembly language method of )
  206.     MOVE.L    TEHandle,-(A6)        ( accessing a variable's contents )
  207.     RTS
  208. END-CODE
  209.  
  210. : Shift?   (   -  f )     \ checks the event record to see if the
  211.             \ shift key was pressed. 
  212.     EVENT-RECORD Modifiers + W@    ( get modifiers word )
  213.     ShiftMask AND            ( isolate shiftbit )
  214.     IF -1 ELSE 0 THEN  
  215. ;
  216.     
  217. : LineHeight    (   -   lineheight  )    ( looks in the textedit record to )
  218.     @TEHandle @ teLineHite + W@  ;    ( see how tall each line is )    
  219.     
  220. : #Lines    (   -   #lines  )    ( looks in the textedit record to )
  221.     @TEHandle @ teNLines + W@  ;    ( see how many lines of text there
  222.                       are in this file )
  223. : adjustFontMenu
  224. \ adjust font menu and currentFont variable
  225.     myStyle w@ ( font ID ) fontName call getFname
  226.     #fonts @ 0 DO
  227.         fontMenu @ i itemName call GetItem
  228.         itemName fontName =string 
  229.         IF  FontMenu @ currentFont @ 0 check 
  230.             \ uncheck previous font selection 
  231.             FontMenu @ i -1 check
  232.              i currentFont !
  233.             leave
  234.         THEN
  235.     LOOP
  236. ;
  237.  
  238. : adjustStyleMenu { | face - }
  239.     myStyle tsFace + w@ -> face
  240.     8 0 DO 
  241.       1 i scale face and ( get style bit )
  242.       if -1 else 0 then
  243.       styleMenu @ i 2+ rot check 
  244.     LOOP    
  245. ;
  246.     
  247. : adjustSizeMenu
  248.     SizeMenu @ currentSize @ 0 check 
  249.     myStyle tsSize + w@ ( size )
  250.     SizeIDTable + c@ ( sizeID )
  251.     dup currentSize !
  252.     SizeMenu @ swap -1 check     
  253. ;
  254.  
  255. : getCurrentStyle { | LHite FAsc -- }
  256.     ( updates variable currentFont )
  257.     ( size and Face kept in myStyle )
  258.     ( LHite and FAsc are currently not used )
  259.  
  260.     @TEHandle @ teselStart + w@ \ get start of selection
  261.                   \ (or insertion point)
  262.     ( offset ) myStyle ^ LHite ^ FAsc @TEHandle
  263.         call TEGetStyle
  264.     
  265.     adjustFontMenu
  266.     adjustStyleMenu
  267.     adjustSizeMenu
  268. ;
  269.  
  270. : AdjustTERect                ( adjust terect size for the
  271.                       presence of scrollbars )
  272.     portRect Editor + 4 + W@    ( get bottom coord )
  273.     16 -                 ( subtract 16 for height of scrollbar )
  274.     teViewRect @TEHandle @ + 4 + W!    ( store new coord back in text edit
  275.                       record )
  276.                       
  277.     portRect Editor + 6 + W@    ( get right coord )
  278.     16 -                 ( subtract 16 for width of scrollbar )
  279.     teViewRect @TEHandle @ + 6 + W!    ( store new coord in textedit record )
  280. ;
  281.     
  282. : Visible?    (   -  f  )        ( checks visible flag in window )
  283.     Editor wVisible + C@  ;        ( record to see if window is 
  284.                       currently visible )
  285.  
  286. \ ***** event handlers *****
  287.  
  288. : ACTIVATE-HANDLER
  289.     RUN-ACTIVATE
  290.     EVENT-RECORD Modifiers + W@    ( get modifiers word )
  291.     1 AND IF     
  292.         @TEHandle CALL TEActivate
  293.         getCurrentStyle
  294.     ELSE     
  295.         @TEHandle CALL TEDeactivate
  296.     THEN    
  297. ;
  298.  
  299.     
  300. : UPDATE-HANDLER
  301.     Editor CALL SetPort
  302.     AdjustTERect
  303.     Editor CALL BeginUpdate
  304.        Editor CALL DrawControls
  305.        Editor CALL DrawGrowIcon
  306.        Editor portRect + @TEHandle CALL TEUpdate
  307.     Editor CALL EndUpdate
  308. ;
  309.  
  310. : CONTENT-HANDLER { | theMouse -- }
  311.     RUN-CONTENT
  312.     Editor CALL SetPort
  313.  
  314.     ^ theMouse CALL GetMouse
  315.     theMouse @TEHandle @ TEViewRect + call PtInRect
  316.     IF 
  317.         theMouse Shift? @TEHandle CALL TEClick
  318.         getCurrentStyle        
  319.     THEN
  320. ;
  321.  
  322. : CLOSEBOX-HANDLER
  323.     Editor                ( Editor windowpointer )
  324.     EVENT-RECORD Where + @        ( global mouse coordinates )
  325.     CALL TrackGoAway        ( follow the mouse to see if it
  326.                       is released in the closebox )
  327.     IF Editor CALL HideWindow THEN
  328. ;
  329.     
  330.     
  331. \ **** main editor example code *****
  332.  
  333. : POP-UP
  334.     Editor CALL ShowWindow
  335.     Editor CALL SelectWindow    ( selecting the Editor window )
  336.     EditBar @ CALL SetMenuBar    ( make EditBar the current menubar )
  337.     CALL DrawMenuBar ;        ( redraw the menubar )
  338.     
  339. : SetScrollLimits
  340.     Scroll @ 0 CALL SetMinCtl
  341.     Scroll @ #Lines CALL SetMaxCtl   
  342.     Scroll @ 0 CALL SetCtlValue 
  343.     0 lastVs !  
  344.     hScroll @ 0 CALL SetMinCtl
  345.     hScroll @ 1000 CALL SetMaxCtl   
  346.     hScroll @ 0 CALL SetCtlValue 
  347.     0 lastHs !  
  348. ;
  349.  
  350.  
  351. : EditFile   {   | char exitflag --   }
  352.     BEGIN
  353.         Visible?
  354.         IF
  355.             ?TERMINAL IF
  356.             KEY -> char    ( get the character )
  357.                char 14 = IF
  358.                    0 -> exitflag        ( if cmd '.' exit )
  359.             ELSE
  360.                 char @TEHandle CALL TEKey    ( else insert )
  361.                 1 -> exitflag            ( char )
  362.             THEN
  363.         ELSE
  364.                 1 -> exitflag    ( if no key pressed, keep looping )
  365.             THEN
  366.         
  367.         ELSE
  368.             0 -> exitflag        ( if window's been closed, exit )
  369.         THEN
  370.     exitflag            ( check exit condition )
  371.     WHILE
  372.         @TEHandle CALL TEIdle
  373.     REPEAT
  374. ;
  375.     
  376.     
  377. : Open 
  378.     Pop-Up
  379.     Editor CALL SetPort
  380.        
  381.     TERect TERect CALL TEStyleNew TEHandle ! \ get new style TE record 
  382.     -1 teCROnly @TEHANDLE @ + W!        ( no word wrap )
  383.     -1 teCarAct @TEHandle @ + C!        ( activate caret )
  384.     -1 @TEHandle call TEAutoView
  385.  
  386.     ( get the first 1K of text )
  387.     0 VIRTUAL 1024 0 @TEHandle TEStylinsert
  388.     0 0 @TEHandle CALL TESetSelect
  389.     15 ( doAll ) myStyle -1 ( redraw) @TEHandle
  390.         call TESetStyle    
  391.     adjustFontMenu
  392.     adjustStyleMenu
  393.     adjustSizeMenu
  394.        
  395.     AdjustTERect                ( initialize the text )
  396.     PortRect Editor + @TEHandle CALL TEUpdate 
  397.     @TEHandle CALL TEDeactivate
  398.     @TEHandle CALL TEActivate
  399.  
  400.     SetScrollLimits                ( initialize the window's )
  401.     Editor CALL DrawControls        ( appearance )
  402.     Editor CALL DrawGrowIcon
  403.  
  404.     ['] UPDATE-HANDLER UpdateHook !        ( install custom event )
  405.     ['] CONTENT-HANDLER ContentHook !    ( handling routines )
  406.     ['] ACTIVATE-HANDLER ActivateHook !    
  407.     ['] CLOSEBOX-HANDLER CloseBoxHook !  ;
  408.        
  409.     
  410. \ ***** menu handlers *****
  411.  
  412. : HandleDeskAcc ( item# -  )
  413.     APPLEMENU @ SWAP DESKNAME CALL GETITEM    
  414.     DESKNAME CALL OPENDESKACC
  415.     DROP    
  416. ;
  417.  
  418. : DO-APPLE ( item# -  )        ( handles selections from the apple menu )
  419.     dup 1 =            ( check to see if it is the 'about' item )
  420.     IF
  421.         ( AboutEdit    )    ( About Editor ... )
  422.         drop
  423.     ELSE            ( otherwise, handle it as a desk accessory )
  424.         HandleDeskAcc
  425.     THEN 
  426. ;
  427.     
  428.  
  429. : NewFile ;            ( This is where the other menu items )
  430. : OpenFile ;            ( would be handled )
  431. : CloseFile ;
  432. : SaveFile ;
  433. : SaveAs ;
  434. : Revert ;
  435.  
  436. : DO-FILE ( item# -  )        ( handles selections from the file menu )
  437.     CASE
  438.     1 OF    NewFile        ENDOF
  439.     2 OF      OpenFile    ENDOF
  440.     3 OF     CloseFile    ENDOF
  441.     4 OF    SaveFile    ENDOF
  442.     5 OF    SaveAs        ENDOF
  443.     6 OF    Revert        ENDOF
  444.     ENDCASE  ;
  445.  
  446. : DO-EDIT ( item# - )        ( handles selections from the edit menu )
  447.     CASE
  448.     1 OF    ( TEUndo )        ENDOF
  449.     3 OF    @TEHandle CALL TECut    ENDOF
  450.     4 OF    @TEHandle CALL TECopy    ENDOF
  451.     5 OF    @TEHandle CALL TEStylPaste ENDOF
  452.     6 OF    @TEHandle CALL TEDelete    ENDOF
  453.     ENDCASE  ;
  454.  
  455. : DO-Font { item# | fontID - }    ( handles selections from the Font menu )
  456.     FontMenu @ item# Fontname call getitem
  457.     Fontname ^ fontID call getFNum
  458.     ^ fontID w@ myStyle w! 
  459.         \ put into tsFont field of style record
  460.     1 ( doFont) myStyle -1 ( redraw) @TEHandle
  461.         call TESetStyle
  462.     FontMenu @ currentFont @ 0 check 
  463.     FontMenu @ item# -1 check
  464.      item# currentFont !
  465. ;
  466.  
  467. : Do-Style { item# | facefield -- }
  468.     myStyle tsFace + -> facefield
  469.     item# CASE
  470.         1 OF ( plain text ) 
  471.           0 facefield w!
  472.         ENDOF     
  473.         
  474.         facefield w@ 
  475.         1 item# 2- scale xor 
  476.         facefield w! \ flip bit
  477.     ENDCASE
  478.  
  479.     2 ( doFace) myStyle -1 ( redraw) @TEHandle
  480.         call TESetStyle
  481.     adjustStyleMenu
  482. ;
  483.  
  484.     
  485. : Do-Size  ( item# - )     ( handles selections from the size menu )
  486.     SizeTable + c@
  487.     myStyle tsSize + w!
  488.     4 ( doSize) myStyle -1 ( redraw) @TEHandle
  489.         call TESetStyle
  490.     adjustSizeMenu
  491. ;
  492.             
  493. : MBAR-HANDLER  ( item# menuID -  )        ( this word handles )
  494.     CASE                    ( selections from the )
  495.     APPLEID OF DO-APPLE      ENDOF        ( whole edit menubar )
  496.     FILEID     OF DO-FILE      ENDOF
  497.      EDITID    OF DO-EDIT    ENDOF
  498.     FontID     OF DO-Font    ENDOF
  499.     SIZEID    OF DO-Size    ENDOF
  500.     STYLEID    OF DO-Style    ENDOF
  501.     ENDCASE  
  502.     0 CALL HILITEMENU  
  503. ;
  504.  
  505.  
  506. \ ***** control action routines *****
  507.  
  508. ( A control action routine specifies what action should take place
  509.   WHILE a control is being held down.)
  510.  
  511. : ScrollText  { dv  dh  --   }
  512.     dh dv @TEHandle CALL TEScroll   
  513. ;
  514.     
  515. : DO-Scroll { part-code  | ctlvalue  -  }
  516.    part-code
  517.    CASE
  518.       inuparrow OF  Scroll @ CALL GetCtlValue  -> ctlvalue
  519.               ctlvalue 0= NOT 
  520.             IF
  521.                   Scroll @ ctlvalue 1- CALL SetCtlValue
  522.             5 0  ScrollText        
  523.             THEN
  524.         ENDOF
  525.                 
  526.       indownarrow OF  Scroll @ CALL GetCtlValue  -> ctlvalue
  527.         ctlvalue #Lines = NOT
  528.             IF
  529.             Scroll @ ctlvalue 1+ CALL SetCtlValue
  530.             -5 0 ScrollText    
  531.             THEN
  532.         ENDOF
  533.                 
  534.       inpageup  OF  Scroll @ CALL GetCtlValue  -> ctlvalue
  535.         ctlvalue 0= NOT 
  536.             IF
  537.             Scroll @ ctlvalue 5 - CALL SetCtlValue
  538.             25 0  ScrollText    
  539.             THEN
  540.         ENDOF
  541.                 
  542.       inpagedown OF  Scroll @ CALL GetCtlValue   -> ctlvalue
  543.         ctlvalue #Lines = NOT
  544.              IF                
  545.                   Scroll @ ctlvalue 5 + CALL SetCtlValue
  546.             -25 0  ScrollText   
  547.              THEN
  548.         ENDOF
  549.    ENDCASE  
  550.    Scroll @ call GetCtlValue lastVs ! 
  551. ;
  552.  
  553. : DO-hScroll { part-code  | ctlvalue  -  }
  554.    part-code
  555.    CASE
  556.       inuparrow OF hScroll @ CALL GetCtlValue  -> ctlvalue
  557.               ctlvalue 0= NOT 
  558.             IF
  559.                   hScroll @ ctlvalue 1- CALL SetCtlValue
  560.             0 5 ScrollText        
  561.             THEN
  562.         ENDOF
  563.                 
  564.       indownarrow OF hScroll @ CALL GetCtlValue  -> ctlvalue
  565.         ctlvalue #Lines = NOT
  566.             IF
  567.             hScroll @ ctlvalue 1+ CALL SetCtlValue
  568.             0 -5 ScrollText    
  569.             THEN
  570.         ENDOF
  571.                 
  572.       inpageup  OF hScroll @ CALL GetCtlValue  -> ctlvalue
  573.         ctlvalue 0= NOT 
  574.             IF
  575.             hScroll @ ctlvalue 5 - CALL SetCtlValue
  576.             0 25 ScrollText    
  577.             THEN
  578.         ENDOF
  579.                 
  580.       inpagedown OF hScroll @ CALL GetCtlValue  -> ctlvalue
  581.         ctlvalue #Lines = NOT
  582.              IF                
  583.                   hScroll @ ctlvalue 5 + CALL SetCtlValue
  584.             0 -25 ScrollText   
  585.              THEN
  586.         ENDOF
  587.    ENDCASE    
  588.    hScroll @ call GetCtlValue lastHs ! 
  589. ;
  590.  
  591. : ControlAction  ( part-code  control-handle -  )
  592.     CASE
  593.          Scroll @ OF DO-Scroll     ENDOF
  594.         hScroll @ OF DO-hScroll ENDOF
  595.         swap drop
  596.     ENDCASE
  597. ;
  598.  
  599.  
  600. \ ***** scrollbar thumb control handler *****
  601.  
  602. : DO-vThumb { | ctlV }
  603.     inThumb = IF
  604.     scroll @ call getCtlValue -> ctlV
  605.     lastVs @ ctlV - 5 * 0 scrollText
  606.     ctlV lastVs !
  607.     THEN
  608. ;
  609.  
  610. : DO-hThumb { | ctlV }
  611.     inThumb = IF
  612.     hscroll @ call getCtlValue -> ctlV
  613.     0 lastHs @ ctlV - 5 * scrollText
  614.     ctlV lastHs !
  615.     THEN 
  616. ;
  617.   
  618. : ControlHandler  ( part-code  control-handle -  )
  619.     CASE
  620.          Scroll @ OF DO-vThumb     ENDOF
  621.         hScroll @ OF DO-hThumb  ENDOF
  622.         swap drop
  623.     ENDCASE
  624. ;
  625.  
  626.  
  627.  
  628. \ ***** initialization *****
  629.  
  630. : INIT-MBAR
  631.     EditBar ADD
  632.     EditBar APPLEMENU ADD        
  633.     APPLEMENU @ "drvr call addresmenu
  634.     EditBar FileMenu  ADD
  635.     EditBar EditMenu  ADD
  636.     EditBar FontMenu  ADD    
  637.     Fontmenu @ "font call addresmenu
  638.     Fontmenu @ call countMItems #fonts !
  639.     EditBar SizeMenu  ADD 
  640.     EditBar StyleMenu ADD
  641. ;
  642.     
  643. : INIT-TASK
  644.     Editor ADD        ( make the Editor window )
  645.     Editor Scroll ADD    ( add vertical scroll bar )
  646.     Editor hScroll ADD    ( add horizontal scroll bar )
  647.     Editor EditTask BUILD ;    ( link the window to the task )
  648.     
  649. : START-TASK
  650.     ACTIVATE        
  651.     ['] ControlAction CAction !    
  652.     ['] ControlHandler Control-Vector !
  653.     ['] MBAR-HANDLER MENU-VECTOR !    ( install menu handling routine )
  654.     BEGIN
  655.         STANDARD-GETFILE
  656.         IF
  657.         Open
  658.         EditFile
  659.         THEN
  660.         bye
  661.     AGAIN 
  662. ;
  663.  
  664. : INIT-EDIT                ( initializes and starts Editor )
  665.     INIT-TASK            ( make the task and window )
  666.     INIT-MBAR            ( make the menubar and the menus )
  667.     EditBar EditTask MBAR>TASK    ( link the menubar to the task )
  668.     4 myStyle w!    \ default font, Monaco
  669.     0 myStyle 2+ w!    \ default face, plain text
  670.     9 myStyle 4 + w! \ default size, 9 point
  671.     0 myStyle 6 + !    \ RGBcolor = ...
  672.     0 myStyle 10 + w! \ ...black    
  673.     4   TERect     W!        ( define the text edit rectangle )
  674.     4   TERect 2+  W!
  675.     288 TERect 4 + W!
  676.     503 TERect 6 + W!
  677.     EditTask START-TASK  
  678. ;
  679.  
  680. cr .( to create a stand-alone application, type: )
  681. cr .( TURNKEY INIT-EDIT editor )